
SEGMENT PROCEDURE USERPROGRAM(VAR INPUT,OUTPUT: FIB);
BEGIN FWRITELN(SYSTERM^);
  PL := 'No user program linked in';
  FWRITESTRING(SYSTERM^,PL,0)
END (*USERPROGRAM*) ;

SEGMENT PROCEDURE COMPILER(VAR USERINFO: INFOREC);
  SEGMENT PROCEDURE COMPINIT;
  BEGIN END (*COMPINIT*) ;
BEGIN FWRITELN(SYSTERM^);
  PL := 'No compiler linked in';
  USERINFO.ERRNUM := 400;
  FWRITESTRING(SYSTERM^,PL,0)
END (*COMPILER*) ;

SEGMENT PROCEDURE EDITOR; 
BEGIN FWRITELN(SYSTERM^);
  PL := 'No editor linked in';
  FWRITESTRING(SYSTERM^,PL,0)
END (*EDITOR*) ;

SEGMENT PROCEDURE FILEHANDLER;
BEGIN FWRITELN(SYSTERM^);
  PL := 'No file handler linked in';
  FWRITESTRING(SYSTERM^,PL,0)
END (*FILEHANDLER*) ;

SEGMENT PROCEDURE DEBUGGER;
BEGIN FWRITELN(SYSTERM^);
  PL := 'No debugger linked in';
  FWRITESTRING(SYSTERM^,PL,0)
END (*DEBUGGER*) ;

SEGMENT PROCEDURE INITIALIZE;
  VAR DOTRITON,JUSTBOOTED: BOOLEAN; LTITLE: STRING[20];
      DISPLAY: ARRAY [0..79,0..19] OF INTEGER; (*FOR TRITON*)

  PROCEDURE BUILDUNITABLE;
    VAR LUNIT: UNITNUM; LDIR: DIRP;
  BEGIN
    FOR LUNIT := 0 TO MAXUNIT DO
      WITH UNITABLE[LUNIT] DO
	BEGIN UISBLKD := FALSE; UVID := '';
	  IF UNITBUSY(LUNIT) THEN UNITCLEAR(LUNIT)
	END;
    UNITABLE[1].UVID := 'CONSOLE';
    UNITABLE[2].UVID := 'SYSTERM';
    UNITABLE[4].UISBLKD := TRUE;
    UNITABLE[4].UEOVBLK := 0;
    UNITABLE[5].UISBLKD := TRUE;
    UNITABLE[5].UEOVBLK := 0;
    SYVID := '';
    LUNIT := VOLSEARCH(SYVID,TRUE,LDIR);
    SYVID := UNITABLE[SYSCOM^.SYSUNIT].UVID;
    IF LENGTH(SYVID) = 0 THEN HALT;
    UNITCLEAR(6);
    IF IORESULT = ORD(INOERROR) THEN
      UNITABLE[6].UVID := 'PRINTER';
    UNITCLEAR(7);
    IF IORESULT = ORD(INOERROR) THEN
      UNITABLE[7].UVID := 'SPEAKER';
    UNITCLEAR(8);
    IF IORESULT = ORD(INOERROR) THEN
      UNITABLE[8].UVID := 'NETWORK';
  END (*BUILDUNITABLE*) ;

  PROCEDURE INITCHARSET;
  TYPE CHARSET= ARRAY [32..127] OF
		  PACKED ARRAY [0..9] OF 0..255;
  VAR I: INTEGER;
      TRIX: RECORD CASE BOOLEAN OF
	      TRUE:  (CHARADDR: INTEGER);
	      FALSE: (CHARBUFP: ^ CHAR)
	    END;
      CHARBUF: RECORD
		   SET1: CHARSET;
		   FILLER1: PACKED ARRAY [0..63] OF CHAR;
		   SET2: CHARSET;
		   FILLER2: PACKED ARRAY [0..63] OF CHAR;
		   TRITON: ARRAY [0..63,0..3] OF INTEGER
		 END (*CHARBUF*) ;
      LFIB: FIB;
  BEGIN FINIT(LFIB,NIL,-1);
    LTITLE := '*SYSTEM.CHARSET';
    FOPEN(LFIB,LTITLE,TRUE,NIL);
    IF LFIB.FISOPEN THEN
      BEGIN UNITWRITE(3,TRIX,128);
	IF IORESULT = ORD(INOERROR) THEN
	  BEGIN
	    WITH LFIB.FHEADER DO
	      BEGIN DOTRITON := DLASTBLK-DFIRSTBLK > 4;
		UNITREAD(LFIB.FUNIT,CHARBUF,SIZEOF(CHARBUF),DFIRSTBLK)
	      END;
	    TRIX.CHARADDR := 512-8192;	(*UNIBUS TRICKYNESS!*)
	    FOR I := 32 TO 127 DO
	      BEGIN
		MOVELEFT(CHARBUF.SET1[I],TRIX.CHARBUFP^,10);
		TRIX.CHARADDR := TRIX.CHARADDR+16
	      END;
	    TRIX.CHARADDR := 512-6144;
	    FOR I := 32 TO 127 DO
	      BEGIN
		MOVELEFT(CHARBUF.SET2[I],TRIX.CHARBUFP^,10);
		TRIX.CHARADDR := TRIX.CHARADDR+16
	      END;
	    UNITABLE[3].UVID := 'GRAPHIC';
	    UNITWRITE(3,I,0)
	  END
      END
    ELSE
      SYSCOM^.MISCINFO.HAS8510A := FALSE;
    IF DOTRITON THEN
      BEGIN (*INITIALIZE DISPLAY ARRAY*)
	FILLCHAR(DISPLAY,SIZEOF(DISPLAY),0);
	FOR I := 0 TO 63 DO MOVELEFT(CHARBUF.TRITON[I],DISPLAY[I,10],8)
      END;
    FCLOSE(LFIB,CNORMAL)
  END (*INITCHARSET*) ;

BEGIN
  JUSTBOOTED := EMPTYHEAP = NIL;
  IF JUSTBOOTED THEN
    BEGIN (*BASIC FILE AND HEAP SETTUP*)
      NEW(INPUTFIB,TRUE,FALSE); FINIT(INPUTFIB^,NIL,0);
      NEW(OUTPUTFIB,TRUE,FALSE); FINIT(OUTPUTFIB^,NIL,0);
      NEW(SYSTERM,TRUE,FALSE); FINIT(SYSTERM^,NIL,0);
      NEW(INPUTFIB^.FWINDOW);
      NEW(OUTPUTFIB^.FWINDOW);
      NEW(SYSTERM^.FWINDOW);
      WITH USERINFO DO
        BEGIN
          NEW(SYMFIBP,TRUE,FALSE); FINIT(SYMFIBP^,NIL,-1);
          NEW(CODEFIBP,TRUE,FALSE); FINIT(CODEFIBP^,NIL,-1)
        END;
      MARK(EMPTYHEAP)
    END
  ELSE (*ALREADY UNDERWAY*)
    BEGIN
      FCLOSE(USERINFO.SYMFIBP^,CNORMAL);
      FCLOSE(USERINFO.CODEFIBP^,CNORMAL);
      RELEASE(EMPTYHEAP)
    END;
  DEBUGINFO := NIL; DOTRITON := FALSE;
  IPOT[0] := 1; IPOT[1] := 10; IPOT[2] := 100;
  IPOT[3] := 1000; IPOT[4] := 10000;
  WITH SYSCOM^ DO
    BEGIN
      FILLER[0] := CHR(CRTCTRL.FILLCOUNT);
      FILLCHAR(FILLER[1],CRTCTRL.FILLCOUNT,CHR(0));
      XEQERR := 0; IORSLT := INOERROR;
      BUGSTATE := 0; GDIRP := NIL
    END;
  BUILDUNITABLE;
  IF JUSTBOOTED THEN
    BEGIN DKVID := SYVID;
      WITH THEDATE DO
	BEGIN MONTH := 0; DAY := 0; YEAR := 0 END;
      LTITLE := 'CONSOLE:';
      FOPEN(INPUTFIB^,LTITLE,TRUE,NIL);
      FOPEN(OUTPUTFIB^,LTITLE,TRUE,NIL);
      LTITLE := 'SYSTERM:';
      FOPEN(SYSTERM^,LTITLE,TRUE,NIL);
      WITH USERINFO DO
        BEGIN (*INITIALIZE WORK FILES ETC*)
	  SYMTID := ''; CODETID := ''; WORKTID := '';
	  SYMVID := SYVID; CODEVID := SYVID; WORKVID := SYVID;
          LTITLE := '*SYSTEM.WRK.TEXT';
          FOPEN(SYMFIBP^,LTITLE,TRUE,NIL);
	  GOTSYM := SYMFIBP^.FISOPEN;
	  IF GOTSYM THEN
	    SYMTID := SYMFIBP^.FHEADER.DTID;
	  FCLOSE(SYMFIBP^,CNORMAL);
          LTITLE := '*SYSTEM.WRK.CODE';
          FOPEN(CODEFIBP^,LTITLE,TRUE,NIL);
	  GOTCODE := CODEFIBP^.FISOPEN;
	  IF GOTCODE THEN
	    CODETID := CODEFIBP^.FHEADER.DTID;
	  FCLOSE(CODEFIBP^,CNORMAL);
          STUPID := SYSCOM^.MISCINFO.STUPID
	END
    END;
  FRESET(INPUTFIB^);
  FRESET(OUTPUTFIB^);
  FRESET(SYSTERM^);
  IF NOT JUSTBOOTED THEN
    IF GFILES[0] <> INPUTFIB THEN
      FCLOSE(GFILES[0]^,CNORMAL);
  GFILES[0] := INPUTFIB;
  GFILES[1] := OUTPUTFIB;
  GFILES[2] := SYSTERM;
  GFILES[3] := NIL; GFILES[4] := NIL; GFILES[5] := NIL;
  IF SYSCOM^.MISCINFO.HAS8510A THEN INITCHARSET;
  CLEARSCREEN; WRITELN(OUTPUT);
  IF JUSTBOOTED THEN
    BEGIN
      IF DOTRITON THEN
        BEGIN (*ASSUME DATA MEDIA SCREEN*)
          WRITE(OUTPUT,CHR(30),CHR(32),CHR(42));
          UNITWRITE(3,DISPLAY[-80],23)
        END;
      WRITELN(OUTPUT,'Welcome  ',SYVID,',  to');
      IF DOTRITON THEN WRITELN(OUTPUT);
      WRITE(OUTPUT,'U.C.S.D.  Pascal  System  I.3')
    END
  ELSE
    WRITE(OUTPUT,'System re-initialized')
END (*INITIALIZE*) ;

PROCEDURE EXECERROR;
BEGIN
  WITH SYSCOM^ DO
    BEGIN
      IF XEQERR = 4 THEN
	BEGIN RELEASE(EMPTYHEAP);
	  PL := '**** STACK OVERFLOW!!';
	  UNITWRITE(2,PL[1],LENGTH(PL));
	  EXIT(COMMAND)
	END;
      BOMBP^.MSIPC := BOMBIPC;
      IF BUGSTATE <> 0 THEN
	BEGIN DEBUGGER; XEQERR := 0 END
      ELSE
	BEGIN FWRITELN(SYSTERM^);
	  WRITELN(OUTPUT,'Run time error # ',ORD(XEQERR));
	  WRITE(OUTPUT,'S# ',BOMBP^.MSSEG^[0] MOD 256);
	  WRITE(OUTPUT,', P# ',BOMBP^.MSJTAB^[0] MOD 256);
	  WRITE(OUTPUT,', I# ',
		BOMBIPC-ORD(BOMBP^.MSJTAB)+2+BOMBP^.MSJTAB^[-1]);
	  IF NOT SPACEWAIT THEN EXIT(COMMAND)
	END
    END
END (*EXECERROR*) ;

FUNCTION CHECKDEL(CH: CHAR; VAR SINX: INTEGER): BOOLEAN;
BEGIN CHECKDEL := FALSE;
  WITH SYSCOM^,CRTCTRL,CRTINFO DO
    BEGIN
      IF CH = LINEDEL THEN
	BEGIN CHECKDEL := TRUE;
	  IF (BACKSPACE = CHR(0)) OR (ERASEEOL = CHR(0)) THEN
	    BEGIN SINX := 1;
	      WRITELN(OUTPUT,'<ZAP')
	    END
	  ELSE
	    BEGIN
	      WHILE SINX > 1 DO
		BEGIN SINX := SINX-1; WRITE(OUTPUT,BACKSPACE) END;
	      WRITE(OUTPUT,ESCAPE,ERASEEOL)
	    END
	END;
      IF CH = CHARDEL THEN
	BEGIN CHECKDEL := TRUE;
	  IF SINX > 1 THEN
	    BEGIN SINX := SINX-1;
	      IF BACKSPACE = CHR(0) THEN
		IF CHARDEL < ' ' THEN
		  WRITE(OUTPUT,'_')
		ELSE (*ASSUME PRINTABLE*)
	      ELSE
		BEGIN
		  IF CHARDEL <> BACKSPACE THEN
		    WRITE(OUTPUT,BACKSPACE);
		  WRITE(OUTPUT,' ',BACKSPACE)
		END
	    END
	  ELSE
	    IF CHARDEL = BACKSPACE THEN
	      WRITE(OUTPUT,' ')
	END
    END
END (*CHECKDEL*) ;

PROCEDURE HOMECURSOR;
BEGIN
  WITH SYSCOM^,CRTCTRL DO
    BEGIN
      IF ESCAPE <> CHR(0) THEN
	FWRITECHAR(SYSTERM^,ESCAPE,1);
      FWRITECHAR(SYSTERM^,HOME,1);
      IF (LENGTH(FILLER) > 0) AND (HOME <> CHR(EOL)) THEN
	FWRITESTRING(SYSTERM^,FILLER,0)
    END
END (*HOMECURSOR*) ;

PROCEDURE CLEARSCREEN;
BEGIN HOMECURSOR;
  WITH SYSCOM^,CRTCTRL DO
    BEGIN
      IF MISCINFO.HAS8510A THEN UNITCLEAR(3);
      IF ERASEEOS <> CHR(0) THEN
	BEGIN
	  IF ESCAPE <> CHR(0) THEN
	    WRITE(OUTPUT,ESCAPE);
	  WRITE(OUTPUT,ERASEEOS);
	  IF LENGTH(FILLER) > 0 THEN
	    WRITE(OUTPUT,FILLER)
	END
    END
END (*CLEARSCREEN*) ;

PROCEDURE PROMPT;
  VAR I: INTEGER;
BEGIN HOMECURSOR;
  WITH SYSCOM^,CRTCTRL DO
    BEGIN
      IF ERASEEOL <> CHR(0) THEN
	BEGIN
	  IF ESCAPE <> CHR(0) THEN
	    WRITE(OUTPUT,ESCAPE);
	  WRITE(OUTPUT,ERASEEOL);
	  IF LENGTH(FILLER) > 0 THEN
	    WRITE(OUTPUT,FILLER)
	END;
      IF MISCINFO.SLOWTERM THEN
	BEGIN
	  I := SCAN(LENGTH(PL),=':',PL[1]);
	  IF I <> LENGTH(PL) THEN PL[0] := CHR(I+1)
	END
    END;
  WRITE(OUTPUT,PL)
END (*PROMPT*) ;

FUNCTION GETCHAR(*FLUSH: BOOLEAN*);
  VAR CH: CHAR;
BEGIN
  IF FLUSH THEN UNITCLEAR(1);
  INPUTFIB^.FGOTACHAR := FALSE;
  READ(INPUT,CH);
  IF (CH >= 'a') AND (CH <= 'z') THEN
    CH := CHR(ORD(CH)-ORD('a')+ORD('A'));
  GETCHAR := CH
END (*GETCHAR*) ;

FUNCTION SPACEWAIT;
  VAR CH: CHAR;
BEGIN
  PL := 'Type a <SPACE> to continue';
  REPEAT PROMPT;
    CH := GETCHAR(TRUE)
  UNTIL (CH = ' ') OR (CH = SYSCOM^.CRTINFO.ALTMODE);
  SPACEWAIT := CH <> ' '
END (*SPACEWAIT*) ;

FUNCTION SCANTITLE(*FTITLE: STRING; VAR FVID: VID; VAR FTID: TID;
		    VAR FSEGS: INTEGER; VAR FKIND: FILEKIND*);
  VAR I,RBRACK: INTEGER; CH: CHAR; OK: BOOLEAN;
BEGIN
  FVID := ''; FTID := '';
  FSEGS := 0; FKIND := UNTYPEDFILE;
  SCANTITLE := FALSE; I := 1;
  WHILE I <= LENGTH(FTITLE) DO
    BEGIN CH := FTITLE[I];
      IF CH <= ' ' THEN DELETE(FTITLE,I,1)
      ELSE
	BEGIN
	  IF (CH >= 'a') AND (CH <= 'z') THEN
	    FTITLE[I] := CHR(ORD(CH)-ORD('a')+ORD('A'));
	  I := I+1
	END
    END;
  IF LENGTH(FTITLE) > 0 THEN
    BEGIN
      IF FTITLE[1] = '*' THEN
	BEGIN FVID := SYVID; DELETE(FTITLE,1,1) END;
      I := POS(':',FTITLE);
      IF I <= 1 THEN
	BEGIN
	  IF LENGTH(FVID) = 0 THEN FVID := DKVID;
	  IF I = 1 THEN DELETE(FTITLE,1,1)
	END
      ELSE
	IF I-1 <= VIDLENG THEN
	  BEGIN
	    FVID := COPY(FTITLE,1,I-1);
	    DELETE(FTITLE,1,I)
	  END;
      IF LENGTH(FVID) > 0 THEN
	BEGIN
	  I := POS('[',FTITLE);
	  IF I > 0 THEN I := I-1
	  ELSE I := LENGTH(FTITLE);
	  IF I <= TIDLENG THEN
	    BEGIN
	      IF I > 0 THEN
		BEGIN FTID := COPY(FTITLE,1,I); DELETE(FTITLE,1,I) END;
	      IF LENGTH(FTITLE) = 0 THEN OK := TRUE
	      ELSE
		BEGIN OK := FALSE;
		  RBRACK := POS(']',FTITLE);
		  IF RBRACK = 2 THEN OK := TRUE
		  ELSE
		    IF RBRACK > 2 THEN
		      BEGIN OK := TRUE; I := 2;
			REPEAT CH := FTITLE[I];
			  IF (CH >= '0') AND (CH <= '9') THEN
			    FSEGS := FSEGS*10+ORD(CH)-ORD('0')
			  ELSE OK := FALSE;
			  I := I+1
			UNTIL (I = RBRACK) OR NOT OK
		      END
		END;
	      SCANTITLE := OK;
	      IF OK AND (LENGTH(FTID) > 5) THEN
		BEGIN
		  FTITLE := COPY(FTID,LENGTH(FTID)-4,5);
		  IF FTITLE = '.TEXT' THEN FKIND := TEXTFILE
		  ELSE
		  IF FTITLE = '.CODE' THEN FKIND := CODEFILE
		  ELSE
		  IF FTITLE = '.DATA' THEN FKIND := DATAFILE
		  ELSE
		  IF FTITLE = '.INFO' THEN FKIND := INFOFILE
		  ELSE
		  IF FTITLE = '.GRAF' THEN FKIND := GRAFFILE
		  ELSE
		  IF FTITLE = '.FOTO' THEN FKIND := FOTOFILE
		END
	    END
	END
    END
END (*SCANTITLE*) ;

(* VOLUME AND DIRECTORY HANDLERS *)

FUNCTION FETCHDIR(FUNIT: UNITNUM): BOOLEAN;
  VAR LINX: DIRRANGE; OK: BOOLEAN; HNOW: INTEGER;
BEGIN FETCHDIR := FALSE;
  WITH SYSCOM^,UNITABLE[FUNIT] DO
    BEGIN (*READ IN AND VALIDATE DIR*)
      IF GDIRP = NIL THEN NEW(GDIRP);
      UNITREAD(FUNIT,GDIRP^,SIZEOF(DIRECTORY),DIRBLK);
      OK := IORSLT = INOERROR;
      IF OK THEN
	WITH GDIRP^[0] DO
	  BEGIN OK := FALSE; (*CHECK OUT DIR*)
	    IF (DFIRSTBLK = 0) AND (DFKIND = UNTYPEDFILE) THEN
	      IF (LENGTH(DVID) > 0) AND (LENGTH(DVID) <= VIDLENG) AND
		 (DNUMFILES >= 0) AND (DNUMFILES <= MAXDIR) THEN
		BEGIN OK := TRUE; (*SO FAR SO GOOD*)
		  IF DVID <> UVID THEN
		    BEGIN (*NEW VOLUME IN UNIT...CAREFUL*)
		      LINX := 1;
		      WHILE LINX <= DNUMFILES DO
			WITH GDIRP^[LINX] DO
			  IF (DFKIND <= UNTYPEDFILE) OR
			     (DFKIND > FOTOFILE) OR
			     (LENGTH(DTID) <= 0) OR
			     (LENGTH(DTID) > TIDLENG) OR
			     (DLASTBLK < DFIRSTBLK) OR
			     (DLASTBYTE > FBLKSIZE) OR
			     (DLASTBYTE <= 0) OR
			     (DACCESS.YEAR >= 100) THEN
			    BEGIN OK := FALSE; DELENTRY(LINX,GDIRP) END
			  ELSE
			    LINX := LINX+1;
		      IF NOT OK THEN
			BEGIN (*MUST HAVE BEEN CHANGED...WRITEIT*)
			  UNITWRITE(FUNIT,GDIRP^,
				(DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK);
			  OK := IORSLT = INOERROR
			END
		    END
		END;
	    IF OK THEN
	      BEGIN UVID := DVID; UEOVBLK := DEOVBLK;
		TIME(HNOW,DLOADTIME)
	      END
	  END;
      FETCHDIR := OK;
      IF NOT OK THEN
	BEGIN UVID := ''; UEOVBLK := 0;
	  RELEASE(GDIRP); GDIRP := NIL
	END
    END
END (*FETCHDIR*) ;

PROCEDURE WRITEDIR(*FUNIT: UNITNUM; FDIR: DIRP*);
  VAR HNOW,LNOW: INTEGER; OK: BOOLEAN; LDE: DIRENTRY;
BEGIN
  WITH UNITABLE[FUNIT],FDIR^[0] DO
    BEGIN OK := UVID = DVID;
      IF OK THEN
	BEGIN TIME(HNOW,LNOW);
	  OK := (LNOW-DLOADTIME <= AGELIMIT) AND
		SYSCOM^.MISCINFO.HASCLOCK;
	  IF NOT OK THEN
	    BEGIN (*NO CLOCK OR TOO OLD*)
	      UNITREAD(FUNIT,LDE,SIZEOF(DIRENTRY),DIRBLK);
	      IF IORESULT = ORD(INOERROR) THEN
		OK := DVID = LDE.DVID;
	    END;
	  IF OK THEN
	    BEGIN (*WE GUESS ALL IS SAFE...WRITEIT*)
	      UNITWRITE(FUNIT,FDIR^,
			(DNUMFILES+1)*SIZEOF(DIRENTRY),DIRBLK);
	      OK := IORESULT = ORD(INOERROR);
	      IF OK THEN TIME(HNOW,DLOADTIME)
	    END
	END;
      IF NOT OK THEN
	BEGIN SYSCOM^.IORSLT := ILOSTUNIT;
	  UVID := ''; UEOVBLK := 0
	END
    END
END (*WRITEDIR*) ;

FUNCTION VOLSEARCH(*VAR FVID: VID; LOOKHARD: BOOLEAN; VAR FDIR: DIRP*);
  VAR LUNIT: UNITNUM; OK: BOOLEAN; HNOW,LNOW: INTEGER;
BEGIN VOLSEARCH := 0; FDIR := NIL;
  OK := FALSE; LUNIT := MAXUNIT;
  IF LENGTH(FVID) > 0 THEN
    REPEAT (*FIRST PASS THRU TABLE*)
      OK := FVID = UNITABLE[LUNIT].UVID;
      IF NOT OK THEN LUNIT := LUNIT-1
    UNTIL OK OR (LUNIT = 0);
  IF OK THEN
    IF UNITABLE[LUNIT].UISBLKD THEN
      WITH SYSCOM^ DO
	BEGIN OK := FALSE;  (*SEE IF GDIRP IS GOOD*)
	  IF GDIRP <> NIL THEN
	    IF FVID = GDIRP^[0].DVID THEN
	      BEGIN TIME(HNOW,LNOW);
		OK := LNOW-GDIRP^[0].DLOADTIME <= AGELIMIT
	      END;
	  IF NOT OK THEN
	    IF FETCHDIR(LUNIT) THEN
	      OK := FVID = GDIRP^[0].DVID
	END;
  IF NOT OK AND LOOKHARD THEN
    BEGIN LUNIT := MAXUNIT; (*CHECK EACH DISK UNIT*)
      REPEAT
	WITH UNITABLE[LUNIT] DO
	  IF UISBLKD THEN
	    IF FETCHDIR(LUNIT) THEN
	      OK := FVID = UVID;
	IF NOT OK THEN LUNIT := LUNIT-1
      UNTIL OK OR (LUNIT = 0)
    END;
  IF OK THEN
    BEGIN VOLSEARCH := LUNIT;
      IF UNITABLE[LUNIT].UISBLKD THEN
	BEGIN FDIR := SYSCOM^.GDIRP;
	  TIME(HNOW,FDIR^[0].DLOADTIME)
	END
    END
END (*VOLSEARCH*) ;

FUNCTION DIRSEARCH(*VAR FTID: TID; FINDPERM: BOOLEAN; FDIR: DIRP*);
  VAR I: DIRRANGE; FOUND: BOOLEAN;
BEGIN DIRSEARCH := 0; FOUND := FALSE; I := 1;
  WHILE (I <= FDIR^[0].DNUMFILES) AND NOT FOUND DO
    BEGIN
      WITH FDIR^[I] DO
	IF DTID = FTID THEN
	  IF FINDPERM = (DACCESS.YEAR <> 100) THEN
	    BEGIN DIRSEARCH := I; FOUND := TRUE END;
      I := I+1
    END
END (*DIRSEARCH*) ;

PROCEDURE DELENTRY(*FINX: DIRRANGE; FDIR: DIRP*);
  VAR I: DIRRANGE;
BEGIN
  WITH FDIR^[0] DO
    BEGIN
      FOR I := FINX TO DNUMFILES-1 DO FDIR^[I] := FDIR^[I+1];
      FDIR^[DNUMFILES].DTID := '';
      DNUMFILES := DNUMFILES-1
    END
END (*DELENTRY*) ;

PROCEDURE INSENTRY(*VAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR: DIRP*);
  VAR I: DIRRANGE;
BEGIN
  WITH FDIR^[0] DO
    BEGIN
      FOR I := DNUMFILES DOWNTO FINX DO FDIR^[I+1] := FDIR^[I];
      FDIR^[FINX] := FENTRY;
      DNUMFILES := DNUMFILES+1
    END
END (*INSENTRY*) ;

FUNCTION ENTERTEMP(VAR FTID: TID; FSEGS: INTEGER;
		      FKIND: FILEKIND; FDIR: DIRP): DIRRANGE;
  VAR I,LASTI,DINX: DIRRANGE; LDE: DIRENTRY;

  PROCEDURE FINDMAX(CURINX: DIRRANGE; FIRSTOPEN,NEXTUSED: INTEGER);
    VAR FREEAREA: INTEGER;
  BEGIN
    FREEAREA := NEXTUSED-FIRSTOPEN;
    IF FREEAREA > FSEGS THEN
      BEGIN DINX := CURINX; FSEGS := FREEAREA END
  END (*FINDMAX*) ;

BEGIN (*ENTERTEMP*)
  DINX := 0; LASTI := FDIR^[0].DNUMFILES;
  IF FSEGS = 0 THEN
    BEGIN
      FOR I := 1 TO LASTI DO
	FINDMAX(I,FDIR^[I-1].DLASTBLK,FDIR^[I].DFIRSTBLK);
      FINDMAX(LASTI+1,FDIR^[LASTI].DLASTBLK,FDIR^[0].DEOVBLK)
    END
  ELSE
    BEGIN I := 1;
      WHILE I <= LASTI DO
	BEGIN
	  IF FDIR^[I].DFIRSTBLK-FDIR^[I-1].DLASTBLK >= FSEGS THEN
	    BEGIN DINX := I; I := LASTI END;
	  I := I+1
	END;
      IF DINX = 0 THEN
	IF FDIR^[0].DEOVBLK-FDIR^[LASTI].DLASTBLK >= FSEGS THEN
	  DINX := LASTI+1
    END;
  IF LASTI = MAXDIR THEN DINX := 0
  ELSE
   IF DINX > 0 THEN
    BEGIN
      WITH LDE DO
	BEGIN
	  DFIRSTBLK := FDIR^[DINX-1].DLASTBLK;
	  DLASTBLK := DFIRSTBLK+FSEGS;
	  DFKIND := FKIND; DTID := FTID;
	  DLASTBYTE := FBLKSIZE;
	  WITH DACCESS DO
	    BEGIN MONTH := 0; DAY := 0; YEAR := 100 END
	END;
      INSENTRY(LDE,DINX,FDIR)
    END;
  ENTERTEMP := DINX
END (*ENTERTEMP*) ;

(* FILE STATE HANDLERS *)

PROCEDURE FINIT(*VAR F: FIB; WINDOW: WINDOWP; RECWORDS: INTEGER*);
BEGIN
  WITH F DO
    BEGIN FISOPEN := FALSE; FEOF := TRUE;
      FEOLN := TRUE; FWINDOW := WINDOW;
      IF RECWORDS = 0 THEN FRECSIZE := 1
      ELSE
	IF RECWORDS < 0 THEN FRECSIZE := 0
	ELSE FRECSIZE := RECWORDS+RECWORDS
    END
END (*FINIT*) ;

PROCEDURE FOPEN(*VAR F: FIB; VAR FTITLE: STRING;
		 FOPENOLD: BOOLEAN; JUNK PARAM*);
  LABEL 1;
  VAR LDIR: DIRP; LUNIT: UNITNUM; LINX: DIRRANGE;
      LSEGS: INTEGER; LKIND: FILEKIND; LVID: VID; LTID: TID;
BEGIN SYSCOM^.IORSLT := INOERROR;
  WITH F DO
    IF FISOPEN THEN SYSCOM^.IORSLT := INOTCLOSED
    ELSE
      IF SCANTITLE(FTITLE,LVID,LTID,LSEGS,LKIND) THEN
	BEGIN (*GOT AN OK TITLE*)
	  IF ORD(FOPENOLD) > 1 THEN (*OLD CODE FILE*)
	    FOPENOLD := (ORD(FOPENOLD) = 2) OR (ORD(FOPENOLD) = 4);
	  LUNIT := VOLSEARCH(LVID,TRUE,LDIR);
	  IF LUNIT = 0 THEN SYSCOM^.IORSLT := INOUNIT
	  ELSE
	    WITH UNITABLE[LUNIT] DO
	      BEGIN (*OK...OPEN UP FILE*)
		FISOPEN := TRUE; FEOF := FALSE;
		FEOLN := FALSE; FMODIFIED := FALSE;
		FUNIT := LUNIT; FVID := LVID; FNXTBLK := 0;
		FISBLKD := UISBLKD; FGOTACHAR := FALSE;
		FSOFTBUF := FISBLKD AND (FRECSIZE <> 0);
		IF (LENGTH(LTID) = 0) OR NOT UISBLKD THEN
		 WITH FHEADER DO
		  BEGIN (*DIRECT UNIT OPEN, SET UP DUMMY FHEADER*)
		    DFIRSTBLK := 0; DLASTBLK := 0;
		    IF UISBLKD THEN DLASTBLK := UEOVBLK;
		    DFKIND := LKIND; DTID := '';
		    DLASTBYTE := FBLKSIZE;
		    WITH DACCESS DO
		      BEGIN MONTH := 0; DAY := 0; YEAR := 0 END
		  END
		ELSE
		  BEGIN (*LOOKUP OR ENTER FHEADER IN DIRECTORY*)
		    LINX := DIRSEARCH(LTID,FOPENOLD,LDIR);
		    IF FOPENOLD THEN
		      IF LINX = 0 THEN
			BEGIN SYSCOM^.IORSLT := INOFILE; GOTO 1 END
		      ELSE FHEADER := LDIR^[LINX]
		    ELSE (*OPEN NEW FILE*)
		      IF LINX > 0 THEN
			BEGIN SYSCOM^.IORSLT := IDUPFILE; GOTO 1 END
		      ELSE
			BEGIN (*MAKE A TEMP ENTRY*)
			  IF LKIND = UNTYPEDFILE THEN LKIND := DATAFILE;
			  LINX := ENTERTEMP(LTID,LSEGS,LKIND,LDIR);
			  IF LINX = 0 THEN
			    BEGIN SYSCOM^.IORSLT := INOROOM; GOTO 1 END;
			  FHEADER := LDIR^[LINX]; FMODIFIED := TRUE;
			  WRITEDIR(LUNIT,LDIR)
			END
		  END;
		IF FOPENOLD THEN
		  FMAXBLK := FHEADER.DLASTBLK-FHEADER.DFIRSTBLK
		ELSE FMAXBLK := 0;
		IF FSOFTBUF THEN
		  BEGIN
		    FNXTBYTE := FBLKSIZE; FBUFCHNGD := FALSE;
		    IF FOPENOLD THEN FMAXBYTE := FHEADER.DLASTBYTE
		    ELSE FMAXBYTE := FBLKSIZE;
		    WITH FHEADER DO
		      IF (FRECSIZE = 1) AND (DFKIND = TEXTFILE) THEN
			BEGIN FNXTBLK := 2;
			  IF NOT FOPENOLD THEN
			    BEGIN (*NEW TEXT...NULLS IN FIRST PAGE*)
			      FILLCHAR(FBUFFER,SIZEOF(FBUFFER),0);
			      UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK);
			      UNITWRITE(FUNIT,FBUFFER,FBLKSIZE,DFIRSTBLK+1)
			    END
			END
		  END;
	1:	IF IORESULT <> ORD(INOERROR) THEN
		  BEGIN FISOPEN := FALSE; FEOF := TRUE; FEOLN := TRUE END
	      END
	END
      ELSE SYSCOM^.IORSLT := IBADTITLE
END (*FOPEN*) ;

PROCEDURE FCLOSE(*VAR F: FIB; FTYPE: CLOSETYPE*);
  LABEL 1;
  VAR LINX,DUPINX: DIRRANGE; LDIR: DIRP; FOUND: BOOLEAN;
BEGIN SYSCOM^.IORSLT := INOERROR;
  WITH F DO
    IF FISOPEN AND (FWINDOW <> INPUTFIB^.FWINDOW)
	AND (FWINDOW <> SYSTERM^.FWINDOW) THEN
      BEGIN
	IF FISBLKD THEN
	  WITH FHEADER DO
	    IF LENGTH(DTID) > 0 THEN
	      BEGIN (*FILE IN A DISK DIRECTORY...FIXUP MAYBE*)
		IF FTYPE = CCRUNCH THEN
		  BEGIN FMAXBLK := FNXTBLK;
		    DACCESS.YEAR := 100; FTYPE := CLOCK;
		    IF FSOFTBUF THEN FMAXBYTE := FNXTBYTE
		  END;
		IF FTYPE <> CPURGE THEN FRESET(F);
		IF FMODIFIED OR (DACCESS.YEAR = 100) OR (FTYPE = CPURGE) THEN
		  BEGIN (*HAVE TO CHANGE DIRECTORY ENTRY*)
		    IF FUNIT <> VOLSEARCH(FVID,FALSE,LDIR) THEN
		      BEGIN SYSCOM^.IORSLT := ILOSTUNIT; GOTO 1 END;
		    LINX := 1; FOUND := FALSE;
		    WHILE (LINX <= LDIR^[0].DNUMFILES) AND NOT FOUND DO
		      BEGIN (*LOOK FOR FIRST BLOCK MATCH*)
			FOUND := (LDIR^[LINX].DFIRSTBLK = DFIRSTBLK) AND
				 (LDIR^[LINX].DLASTBLK = DLASTBLK);
			LINX := LINX + 1
		      END;
		    IF NOT FOUND THEN
		      BEGIN SYSCOM^.IORSLT := ILOSTFILE; GOTO 1 END;
		    LINX := LINX - 1; (*CORRECT OVERRUN*)
		    IF ((FTYPE = CNORMAL) AND (LDIR^[LINX].DACCESS.YEAR = 100)) 
			   OR (FTYPE = CPURGE) THEN
			DELENTRY(LINX,LDIR)  (*ZAP FILE OUT OF EXISTANCE*)
		    ELSE
		      BEGIN (*WELL...LOCK IN A PERM DIR ENTRY*)
			DUPINX := DIRSEARCH(DTID,TRUE,LDIR);
			IF (DUPINX <> 0) AND (DUPINX <> LINX) THEN
			  BEGIN (*A DUPLICATE PERM ENTRY...ZAP OLD ONE*)
			    DELENTRY(DUPINX,LDIR);
			    IF DUPINX < LINX THEN LINX := LINX-1
			  END;
			IF LDIR^[LINX].DACCESS.YEAR = 100 THEN
			  IF DACCESS.YEAR = 100 THEN
			    DACCESS := THEDATE
			  ELSE (*LEAVE ALONE...FILER SPECIAL CASE*)
			ELSE
			  IF FMODIFIED AND (THEDATE.MONTH <> 0) THEN
			    DACCESS := THEDATE
			  ELSE
			    DACCESS := LDIR^[LINX].DACCESS;
			DLASTBLK := DFIRSTBLK+FMAXBLK;
			IF FSOFTBUF THEN DLASTBYTE := FMAXBYTE;
			FMODIFIED := FALSE; LDIR^[LINX] := FHEADER
		      END;
		    WRITEDIR(FUNIT,LDIR)
		  END
	      END;
	IF FTYPE = CPURGE THEN
	  IF LENGTH(FHEADER.DTID) = 0 THEN
	    UNITABLE[FUNIT].UVID := '';
1:	FEOF := TRUE; FEOLN := TRUE; FISOPEN := FALSE
      END
END (*FCLOSE*) ;

PROCEDURE FSEEK(*F: FIB; RECNUM: INTEGER*);
BEGIN
END (*FSEEK*) ;
